Interplay's Learn to Program Basic (Review Copy)/Learn to Program Basic Review Copy (Interplay)(June 23, 1998).ISO/pc/ltpbasic/projects/row4.bas

BASIC Source File | 1998-02-21 | 7.4 KB | 342 lines

REM Row 4 Program

REM The REM statements at the
REM bottom of the program contain
REM ideas for changes you can
REM program, to make it your own
REM way.

REM This program uses lots of
REM Gosub commands, over and over
REM in one small-looking loop.
CLS
Gosub Startup
Gosub Init
Gosub DrawGrid
REM Here's the main loop that gets
REM executed over and over:
while TRUE
Gosub AnnounceTurn
Gosub PlayerMove
Gosub TestWinner
if test then
Gosub AnnounceWinner
end
endif
Gosub TestCat
if test Then
Banner "Tie Game! The Cat Wins!"
End
Endif

currentPlayer = currentPlayer + 1
if currentPlayer > numPlayers Then currentPlayer = 1
wend

REM program end
End
REM That's it!  The above 15 lines
REM of code, or so, is the whole
REM program.  The catch, of course,
REM is all the GoSub commands, which
REM execute subroutines listed
REM below.

REM -- program subroutines --

REM Initialize for new game
Init:
REM General Variables
REM "gridNum" defined by startup
winNum = 4
Dim squaresHeld(gridNum*gridNum)

REM Player Variables
Rem "numPlayers" defined by startup
currentPlayer = 1
Dim playerSquare(numPlayers)
Dim playerColor(numPlayers)
Dim stateColors(numPlayers+1)
for i = 1 to numPlayers
Read playerColor(i)
stateColors(i+1) = playerColor(i)
next

REM Grid Variables
Rem -- defined by startup
Rem gridStartX = 20
Rem gridStartY = 4
Rem gridWidth = 38
Rem gridHeight = 38
Rem -------
gridColor = 21 ' Black
gridBack = 10 ' Grey
stateColors(1) = gridBack

REM Square variables
square = 0
squareColor = gridBack

Color 6 ' white
FillRect 0,0 To 320,240
for i = 1 To (gridNum * gridNum)
REM Clear all the square values
squaresHeld(i) = 0
next
return

DrawGrid:
REM Draw a gridNum x gridNum (4x4) grid
Color gridBack
FillRect gridStartX, gridStartY To gridStartX + gridWidth * gridNum, gridStartY + gridHeight * gridNum
Color gridColor
Rect gridStartX, gridStartY To gridStartX + gridWidth * gridNum, gridStartY + gridHeight * gridNum
For i = 1 to gridNum-1
line gridStartX+i*gridWidth,gridStartY To gridStartX + i * gridWidth, gridStartY + gridHeight * gridNum
line gridStartX,gridStartY+i*gridHeight To gridStartX + gridWidth * gridNum, gridStartY + i * gridHeight
Next i
return


Rem Move the player with the mouse
PlayerMove:
sq = playerSquare(currentPlayer)
square = sq
placed = FALSE
while placed = FALSE
x = MouseX - gridStartX
y = MouseY - gridStartY
if x < 0 then x = 0
if y < 0 then y = 0
c = Int(x/gridWidth)
r = Int(y/gridHeight)
if c >= gridNum then c = gridNum-1
if r >= gridNum then r = gridNum-1
sq = r * gridNum + c
if sq <> square Then
squareColor = stateColors(squaresHeld(square+1)+1)
Gosub DrawSquare
squareColor = playerColor(currentPlayer)
square = sq
Gosub DrawSquare
endif

if ClickRect(0,0 to 320,240) then
if squaresHeld(square+1) = 0 then
placed = TRUE
playerSquare(currentPlayer) = square
squaresHeld(square+1) = currentPlayer
else
REM Here you could beep
REM if the user clicks on a
REM square that's already full.
endif
else
REM Right here you could insert
REM code to loop animation, or
REM anything you want to happen
REM when the user isn't doing
REM anything.
Endif

Wend
return

REM Draw a square (square) in a color (squareColor)
DrawSquare:
r = Int(square / gridNum)
c = square Mod gridNum
x1 = gridStartX + c * gridWidth + 1
y1 = gridStartY + r * gridHeight + 1
x2 = x1 + gridWidth - 2
y2 = y1 + gridHeight - 2
Color squareColor
REM FillRect x1,y1 to x2,y2
FillCircle x1+gridWidth/2-2,y1+gridHeight/2-2,gridWidth/2-4
return


REM Test for a winner
REM Returns Test (TRUE for a winner) and Plyr (Player who won)
TestWinner:
test = FALSE
for plyr = 1 to numPlayers
for sq = 0 to (gridNum*gridNum)-1
if squaresHeld(sq+1) = plyr then
r = int(sq/gridNum)
c = sq Mod gridNum
REM look for horizontal run
if gridNum-c >= winNum Then
test = TRUE
for i=sq to sq+winNum-1
if squaresHeld(i+1) <> plyr Then test = FALSE
next
if test = TRUE Then return
endif
REM look for vertical run
if gridNum-r >= winNum Then
test = TRUE
for i = 0 to 3
if squaresHeld(1+sq + i*gridNum) <> plyr Then test = FALSE
next
if test = TRUE Then return
EndIf
REM look for diagonal down
if gridNum-r >= winNum AND gridNum-c >= winNum Then
test = TRUE
for i = 0 to 3
if squaresHeld(1+sq + i*gridNum + i) <> plyr then test = FALSE
next
if test = TRUE then return
endif
REM look for diagonal up
if r >= winNum-1 AND gridNum-c >= winNum Then
test = TRUE
for i = 0 to 3
if squaresHeld(1+sq - i*gridNum +i) <> plyr then test = FALSE
next
if test = TRUE then return
endif
EndIf
Next sq
Next plyr
Return

REM Test for a "Cat" game
REM returns Test (T/F)
TestCat:
Test = TRUE
for i = 0 to (gridNum*gridNum)-1
if squaresHeld(i+1) = 0 Then
Test = FALSE
return
endif
next
return

REM Title and setup
Startup:
CLS
Color 6
TextColor 21
FillRect 0,0 to 320,240
Print " RRRR     OOOOO   W       W"
Print " R   R   O     O  W       W"
Print " RRRR    O     O  W   W   W"
Print " R   R   O     O   W  W  W"
Print " R    R   OOOOO     W  W"
Print
Print "         4    4 "
Print "         4    4 "
Print "         4    4 "
Print "          44444444"
Print "              4 "
Print "              4 "
Print
Print "(Press any key to play)"
while inkey$ = ""
wend
CLS
Color 6
FillRect 0,0 to 320,240
Print "This is a game for two to four"
Print "players.  The object is to place"
Print "four of your markers in a row."
Print "The markers can align horizontally"
Print "or vertically or along a diagonal."
Print

gridNum = 0
numPlayers = 0

Rem set this to 0 to allow user to choose
winNum = 4

while gridNum < 4 OR gridNum > 20
Position 0,6
Print "                                        "
Position 0,6
Input "How large a grid? (4-10) ",gridNum
wend
while numPlayers < 2 OR numPlayers > 4
Position 0,7
Print "                                        "
Position 0,7
Input "How many players? (2-4) ",numPlayers
wend
while winNum < 3 OR winNum > gridNum
Position 0,8
Print "                                        "
Position 0,8
Print "How many in a row to win? (3-"gridNum") ";
Input winNum
wend

gridHeight = 230 / gridNum
gridWidth = gridHeight
gridStartX = 316 - (gridWidth * gridNum)
gridStartY = 119 - (gridHeight * gridNum) / 2

CLS
FillRect 0,0 to 320,240
Print "Okay! Let's go!"
Print "First, though, let's get each"
Print "player's name."
Dim playerName$(numPlayers)
for i = 1 to numPlayers
Print "Player "+str$(i)", what is your name?"
Input temp$
if temp$ = "" then temp$ = "Player "+str$(i)
playerName$(i) = temp$
next
CLS
Return

Rem Announce whose turn it is
AnnounceTurn:
Position 0,0
print "Current"
print "Player:"
print Left$(playername$(currentPlayer),10);"          "
return

REM Announce winner (plyr)
AnnounceWinner:
Banner playerName$(plyr)+" Wins!"
return

REM Player Colors
Data 152 ' Green
Data 200 ' Purple
Data 21     ' Black
Data 94  ' Red


REM Ideas for ways to make the game
REM better:

REM - Jazz up the "Current Player"
REM   display.
REM - Use a paint program to draw a
REM   new "Row 4" title screen, and
REM   display it at the beginning
REM   in place of the cheesy text
REM   screen that's in this code now.
REM - Play a sound when you place
REM   a piece.
REM - Play a buzz sound when you
REM   try to place a piece on a
REM   square that's already full.
REM - Let the user choose how many
REM   squares in a row are needed
REM   to win.  (This one's easy if
REM   you look at the code.)
REM - Use a paint program to draw
REM   customized game pieces for
REM   the 6x6 grid, and if the user
REM   chooses to play the 6x6 grid,
REM   draw your custom pieces
REM   instead of just drawing circles
REM   with the FillCircle() function.